home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / 1svga.zip / SETPAL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-29  |  2KB  |  59 lines
  1. { Set 16/256 Colors Palette /TSR }
  2. {$M 1024,0,0} {$F+}
  3.  
  4. uses Dos,Txt;
  5.  
  6. var OldInt9:procedure;
  7.     OldSS,OldSP,MySS,MySP,L:integer;
  8.     Pal17:array[0..16] of byte;
  9.     Pal256:array[0..767] of byte;
  10.  
  11. { ─────────────── SetPal ─────────────── }
  12. procedure SetPal;
  13. begin
  14.   if Mem[0:$182] in [1,2] then Write(#7);
  15.   case Mem[0:$182] of
  16.     1:SetPalette17(Mem[MemW[0:$184]:MemW[0:$186]]);
  17.     2:SetPalette(0,256,Mem[MemW[0:$188]:MemW[0:$18A]]);
  18.   end;
  19. end;
  20. { ─────────────── MyInt9 ─────────────── }
  21. procedure MyInt9; interrupt;
  22. const Flag:byte=0;
  23. begin
  24.   asm pushf end; OldInt9;
  25.   if Flag=0 then if Mem[0:$417]=3 then begin
  26.     Flag:=1;
  27.     OldSS:=SSeg; OldSP:=SPtr;
  28.     asm cli; mov ss,MySS;  mov sp,MySP; sti end;
  29.     SetPal;
  30.     asm cli; mov ss,OldSS; mov sp,OldSP; sti end;
  31.     Flag:=0;
  32.   end;
  33. end;
  34.  
  35. begin
  36.   Writeln('Set 16/256 Colors Palette V1.0');
  37.   Writeln('Copyright (C) 1994 by Jou-Nan Chen');
  38.   if ParamCount<>1 then begin Writeln('Usage: SetPal Filename'); Halt; end;
  39.   L:=FileLen(ParamStr(1),1);
  40.   if L<0 then begin Writeln('No such file !'); Halt; end;
  41.   if MemW[0:$180]<>1002 then begin
  42.     MemW[0:$184]:=Seg(Pal17);  MemW[0:$186]:=Ofs(Pal17);
  43.     MemW[0:$188]:=Seg(Pal256); MemW[0:$18A]:=Ofs(Pal256);
  44.     if L=17  then begin Mem[0:$182]:=1; FileRead(ParamStr(1),0,L,1,Pal17); end;
  45.     if L=768 then begin Mem[0:$182]:=2; FileRead(ParamStr(1),0,L,1,Pal256); end;
  46.     Writeln('Press [L-Shift]+[R-Shift] to act !');
  47.     MemW[0:$180]:=1002;
  48.     GetIntVec(9,@OldInt9); SetIntVec(9,@MyInt9);
  49.     MySS:=SSeg; MySP:=SPtr;
  50.     Keep(ExitCode);
  51.   end else begin
  52.     if L=17  then begin Mem[0:$182]:=1;
  53.       FileRead(ParamStr(1),0,L,1,Mem[MemW[0:$184]:MemW[0:$186]]); end;
  54.     if L=768 then begin Mem[0:$182]:=2;
  55.       FileRead(ParamStr(1),0,L,1,Mem[MemW[0:$188]:MemW[0:$18A]]); end;
  56.     Writeln('Palette updates !');
  57.   end;
  58. end.
  59.